home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-19 / pkey12_1.zip / CBS.LSP < prev    next >
Text File  |  1992-09-13  |  810b  |  30 lines
  1. ;Change Block Scale
  2. ;
  3. ;
  4. (Defun c:cbs()
  5. (setq oer *error* *error* err2)
  6. (setq ss(ssget))
  7. (initget(+ 1 2 4))
  8. (setq h(getreal "Enter new scale: "))
  9. (setq counter 0)
  10. (prompt "changing scale...")
  11. (while(setq e(ssname ss counter))
  12. (setq etype(cdr(assoc 0(entget e))))
  13. (progn(setq entity(entget e))
  14. (setq old(assoc 41 entity))
  15. (setq new(cons(car old)h))
  16. (setq newentity(subst new old entity))
  17. (entmod newentity)
  18. (setq entity(entget e))
  19. (setq old(assoc 42 entity))
  20. (setq new(cons(car old)h))
  21. (setq newentity(subst new old entity))
  22. (entmod newentity)
  23. (setq entity(entget e))
  24. (setq old(assoc 43 entity))
  25. (setq new(cons(car old)h))
  26. (setq newentity(subst new old entity))
  27. (entmod newentity))
  28. (setq counter(+ counter 1))
  29. (princ)))
  30. (princ "\nType CBS to change block scale of selected blocks.")